home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / REPNAM.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  3.0 KB  |  93 lines
  1.       SUBROUTINE REPNAM 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *   Performs replacements of names, or names+strings attached   
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'FLAGS.h' 
  10.       include 'CURSTA.h' 
  11.       include 'STATE.h' 
  12.       include 'KEYCOM.h' 
  13.       include 'JOBSUM.h' 
  14.       DIMENSION KSP1(100),KSP2(100) 
  15.       NCH=0 
  16.       IPT=0 
  17.       NMOD=IMODIF(NSTREF)   
  18. *--- check for 'REP' key
  19.       DO 10 IK=1,NGLSET 
  20.          IF (KEYREF(IK,1).EQ.9) GOTO 20 
  21.    10 CONTINUE  
  22.       GOTO 999  
  23.    20 CONTINUE  
  24. *--- check for name replacement 
  25.       IF (KEYREF(IK,4).EQ.0) GOTO 999   
  26.       DO 30 I=1,NSNAME  
  27.          CALL NAMSRC(SNAMES(ISNAME+I),SKEYLS(KEYREF(IK,5)+1),   
  28.      +   KEYREF(IK,4),IPOS,LAST)
  29.          IF (IPOS.EQ.0) GOTO 30 
  30.          IPOS=IPOS+KEYREF(IK,5) 
  31.          KREF1=KNAMRF(IPOS,1)   
  32. *--- check illegal  
  33.          IF (KREF1.LT.0) GOTO 30
  34. *--- name must behind last replacement  
  35.          IF (NSSTRT(I).GT.IPT)  THEN
  36. *--- check for string following 
  37.             KPOS=0  
  38.             NSPEC=0 
  39.             IF (KREF1.GT.0)  THEN   
  40.                CALL MATCH(SKYSTR,KKYSTA(KREF1),KKYEND(KREF1),SSTA,NSEND(
  41.      +         I)+1,NCHST,.TRUE.,KPOS,ILEV,NSPEC,KSP1,KSP2) 
  42.                IF (KPOS.EQ.0) GOTO 30   
  43.             ENDIF   
  44. *--- name (+string) do match
  45. *--- set modify flag
  46.             IF (NMOD.LT.10)  NMOD=NMOD+10   
  47. *--- copy from pointer up to name   
  48.             L=NSSTRT(I)-IPT-1   
  49.             IF (L.GT.0)  THEN   
  50.                IF (NCH+L.GT.MXLENG) GOTO 40 
  51.                SSTR(NCH+1:NCH+L)=SSTA(IPT+1:IPT+L)  
  52.                NCH=NCH+L
  53.             ENDIF   
  54.             IPT=MAX(NSEND(I),KPOS)  
  55.             KREF2=KNAMRF(IPOS,2)
  56.             IF (KREF2.GT.0)  THEN   
  57. *--- non-empty replacement string exists
  58.                L=KKYEND(KREF2)-KKYSTA(KREF2)+1  
  59.                IF (NSPEC.EQ.0)  THEN
  60.                   IF (NCH+L.GT.MXLENG) GOTO 40  
  61. *--- replace name by string 
  62.                   SSTR(NCH+1:NCH+L)=SKYSTR(KKYSTA(KREF2):KKYEND(KREF2)) 
  63.                   NCH=NCH+L 
  64.                ELSE 
  65.                   CALL REPSUB(KREF1,KREF2,NSPEC,KSP1,KSP2,NCH)  
  66.                   IF (NCH.GT.MXLENG) GOTO 40
  67.                ENDIF
  68.             ENDIF   
  69.          ENDIF  
  70.    30 CONTINUE  
  71.       IF(NMOD.GE.10)  THEN  
  72. *--- copy SSTR to SSTA, NCH to NCHST
  73.          L=NCHST-IPT
  74.          IF (L.GT.0)  THEN  
  75.             IF (NCH+L.GT.MXLENG) GOTO 40
  76.             SSTR(NCH+1:NCH+L)=SSTA(IPT+1:NCHST) 
  77.             NCH=NCH+L   
  78.          ENDIF  
  79.          IMODIF(NSTREF)=NMOD
  80.          NCHST=NCH  
  81.          SSTA(:NCH)=SSTR(:NCH)  
  82.       ENDIF 
  83.       GOTO 999  
  84.    40 CONTINUE  
  85.       WRITE (MPUNIT,10000)  
  86.       CALL FLPRNT(1,'OVERFLOW',NLLINE(NSTREF)-NFLINE(NSTREF)+1, SIMA
  87.      +(NFLINE(NSTREF)),NDUMMY)  
  88.       NSTATC(6)=NSTATC(6)+1 
  89.       STATUS(11)=.TRUE. 
  90. 10000 FORMAT(/' ++++++ Warning - replacements would lead to overflow',  
  91.      +' in following statement, not done')  
  92.   999 END   
  93.